home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Education
/
World of Education.iso
/
world_s
/
sp12src.zip
/
MARKDOC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-27
|
2KB
|
111 lines
{$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,R-,S-,V+,X+}
{$M 16384,0,655360}
Program MarkDoc;
{ Document marker program - processes the -M+ output from SPELCHEK. }
Uses Dos, Crt;
Const
WorkExt = '.$$$';
BakExt = '.BAK';
BufSize = 16384;
DefaultMark = '#';
Var
StdIn : Text;
InFile, WorkFile : File;
Mark : String;
DocOpen : Boolean;
InBuf : Array[1..BufSize] Of Char;
Procedure FlushToPosition(n : LongInt);
Var
ReadLen : LongInt;
Begin
While (FilePos(InFile) < n) And Not Eof(InFile) Do Begin
ReadLen := n - FilePos(InFile);
If ReadLen > BufSize Then ReadLen := BufSize;
BlockRead(InFile, InBuf, ReadLen);
BlockWrite(WorkFile, InBuf, ReadLen);
End;
End;
Function FileExists(Name : PathStr) : Boolean;
Var
f : File;
Begin
{$I-}
Assign(f, Name);
Reset(f);
If IoResult = 0 Then Begin
FileExists := True;
Close(f);
End Else FileExists := False;
{$I+}
End;
Procedure CloseDocument(Name : PathStr);
Var
f : File;
d : DirStr;
n : NameStr;
e : ExtStr;
BakName : PathStr;
Begin
FlushToPosition(FileSize(InFile));
Close(InFile);
Close(WorkFile);
DocOpen := False;
FSplit(Name, d, n, e);
BakName := d + n + BakExt;
If FileExists(BakName) Then Begin
Assign(f, BakName);
Erase(f);
WriteLn('Erased backup file ', BakName);
End;
Rename(InFile, BakName);
WriteLn('Original file saved in ', BakName);
Rename(WorkFile, Name);
WriteLn('Words marked in ', Name);
End;
Procedure ReadStdIn;
Var
num : LongInt;
p : PathStr;
d : DirStr;
n : NameStr;
e : ExtStr;
s : String;
OutName : PathStr;
Begin
DocOpen := False;
Repeat
ReadLn(StdIn, num, s);
Delete(s, 1, 1);
If (num = 0) And (s <> '') Then Begin
If DocOpen Then CloseDocument(p);
p := s;
FSplit(p, d, n, e);
OutName := d + n + WorkExt;
Assign(InFile, s);
Reset(InFile, 1);
Assign(WorkFile, OutName);
ReWrite(WorkFile, 1);
DocOpen := True;
End Else Begin
FlushToPosition(Pred(num));
BlockWrite(WorkFile, Mark[1], Length(Mark));
End;
Until Eof(StdIn);
If DocOpen Then CloseDocument(p);
End;
Begin
If ParamCount > 0 Then Mark := ParamStr(1) Else Mark := DefaultMark;
DocOpen := False;
Assign(StdIn, '');
Reset(StdIn);
ReadStdIn;
Close(StdIn);
WriteLn('Done!');
End.